home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / c64-preservation-project / educational / intro_to_basic_part_2[commodore_1983].nbz / library (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  5.6 KB  |  218 lines
  1. 1 GOTO10000:REM COMMODORE 64 LIBRARY COPYRIGHT(C) ANDREW COLIN 1983
  2. 1000 REM CONVERT X1 TO BINARY AND DISPLAY
  3. 1010 YY=256:XX=X1:FORKK=1TO8
  4. 1020 YY=YY/2
  5. 1030 IFXX>=YYTHENXX=XX-YY:PRINT"*";:GOTO1050
  6. 1040 PRINT" ";
  7. 1050 NEXTKK
  8. 1060 PRINT:RETURN
  9. 4100 REM EXTRACT SURNAME FROM N1$ AND DELIVER IN Y1$
  10. 4110 JJ=LEN(N1$)
  11. 4120 IFJJ=0THENY1$="":RETURN
  12. 4130 IFMID$(N1$,JJ,1)<"A"ORMID$(N1$,JJ,1)>"[218]"THENJJ=JJ-1:GOTO4120
  13. 4140 FORKK=JJTO1STEP-1
  14. 4150 CC$=MID$(N1$,KK,1)
  15. 4160 IFNOT(CC$>="A"ANDCC$<="Z"ORCC$="-"ORCC$="'")THEN4190
  16. 4170 NEXTKK
  17. 4180 KK=0
  18. 4190 Y1$=MID$(N1$,KK+1,JJ-KK)
  19. 4200 RETURN
  20. 4500 REM TOLERANT INPUT OF NUMBERS
  21. 4510 INPUT XX$
  22. 4520 YY$=""
  23. 4530 FORJJ=1TOLEN(XX$)
  24. 4540 CC$=MID$(XX$,JJ,1)
  25. 4550 IFCC$="O"THENYY$=YY$+"0":GOTO4600
  26. 4560 IFCC$="I"THENYY$=YY$+"1":GOTO4600
  27. 4570 IFCC$=" "THEN4600
  28. 4580 IFNOT(CC$<="9"ANDCC$>="0"ORCC$="."ORCC$="-")THEN4620
  29. 4590 YY$=YY$+CC$
  30. 4600 NEXTJJ
  31. 4610 X1=VAL(YY$):RETURN
  32. 4620 PRINT"NUMBERS CONSIST OF"
  33. 4630 PRINT"DECIMAL DIGITS 0-9,"
  34. 4640 PRINT"+,- AND . ONLY"
  35. 4650 PRINT"PLEASE TRY AGAIN"
  36. 4660 GOTO4510
  37. 5000 REMDISPLAY X1 TO Y1 DECIMAL PLACES
  38. 5010 XX=X1:IFY1>0 AND ABS(X1)<=999999999THEN 5050
  39. 5020 XX=XX+0.5
  40. 5030 PRINT INT(XX);
  41. 5040 RETURN
  42. 5050 IFXX<0THENXX=XX-0.5*10^-Y1:GOTO5070
  43. 5060 XX=XX+0.5*10^-Y1
  44. 5070 NN$=STR$(XX)
  45. 5080 FORPP=1TOLEN(NN$)
  46. 5090 IFMID$(NN$,PP,1)="."THEN PRINT LEFT$(NN$,PP+Y1);:RETURN
  47. 5100 NEXTPP
  48. 5110 PRINTNN$;".";
  49. 5120 FORJJ=1TOY1:PRINT"0";:NEXTJJ
  50. 5130 RETURN
  51. 5500 REM REDUCE FRACTION A1/B1 TO ITS LOWEST TERMS
  52. 5510 REM RESULT IN C1/D1.  LOCALS ARE JJ,KK,LL
  53. 5520 REM ERROR IF A1 OR B1 NOT WHOLE NUMBERS OR IF B1<1
  54. 5530 IFA1=INT(A1)ANDB1=INT(B1)ANDB1>1THEN5550
  55. 5540 PRINT"WRONG PARAMETERS TO FRACTION SIMPLIFIER";A1;B1:STOP
  56. 5550 IFA1=0THENC1=0:D1=1:RETURN
  57. 5560 JJ=A1:KK=B1
  58. 5570 IFA1<0THENJJ=-A1
  59. 5580 IFKK=0THEN 5620
  60. 5590 IFJJ=0 THENJJ=KK:GOTO5620
  61. 5600 IFJJ>KKTHENJJ=JJ-INT(JJ/KK)*KK:GOTO5580
  62. 5610 KK=KK-INT(KK/JJ)*JJ:GOTO5580
  63. 5620 C1=A1/JJ:D1=B1/JJ
  64. 5630 RETURN
  65. 5700 REM DISPLAY X1$ WITHOUT SPLITTIOING WORDS
  66. 5710 XX$=X1$
  67. 5720 PP=LEN(XX$)
  68. 5730 IFPP<=40THEN RR=PP:GOSUB5780:RETURN
  69. 5740 FORQQ=41TO1STEP-1
  70. 5750 IFMID$(XX$,QQ,1)=" "THENRR=QQ-1:GOSUB5780:XX$=RIGHT$(XX$,PP-QQ):GOTO5720
  71. 5760 NEXTQQ
  72. 5770 RR=40:GOSUB5780:XX$=RIGHT$(XX$,PP-40):GOTO5720
  73. 5780 REM INTERNAL SUBROUTINE
  74. 5790 PRINTLEFT$(XX$,RR);:IFRR<40THENPRINT
  75. 5800 RETURN
  76. 6000 REM SEARCH ORDERED LIST IN A1$
  77. 6005 HH=H1:LL=L1
  78. 6010 IFHH<LLTHENM1=-1:RETURN
  79. 6020 M1=INT(0.5*(HH+LL))
  80. 6030 IFX1$=A1$(M1)THENRETURN
  81. 6040 IFX1$<A1$(M1)THENHH=M1-1:GOTO6010
  82. 6050 LL=M1+1:GOTO6010
  83. 6200 REM QUICKSORT OF N1 NUMBERS IN ARRAY A1
  84. 6210 IFSS=1THEN6230
  85. 6220 DIMSS%(100):SS=1:REM DECLARE STACK
  86. 6230 AA=1:BB=N1:SS%(0)=1:PP=1
  87. 6240 XX=AA:YY=BB:ZZ=A1(BB)
  88. 6250 IFXX>=YYTHEN6290
  89. 6260 IFA1(XX)<=ZZTHENXX=XX+1:GOTO6250
  90. 6270 IFA1(YY)>=ZZTHENYY=YY-1:GOTO6250
  91. 6280 DD=A1(YY):A1(YY)=A1(XX):A1(XX)=DD:GOTO6250
  92. 6290 A1(BB)=A1(XX):A1(XX)=ZZ
  93. 6300 IFXX-AA<=1THEN6340
  94. 6310 SS%(PP)=XX:SS%(PP+1)=BB:SS%(PP+2)=2:PP=PP+3
  95. 6320 BB=XX-1:GOTO6240
  96. 6330 PP=PP-3:XX=SS%(PP):BB=SS%(PP+1)
  97. 6340 IFBB-XX<=1THEN6370
  98. 6350 SS%(PP)=3:PP=PP+1:AA=XX+1:GOTO6240
  99. 6360 PP=PP-1
  100. 6370 ONSS%(PP-1)GOTO6380,6330,6360
  101. 6380 RETURN
  102. 6500 REM BUBBLE SORT
  103. 6510 SS$="NO"
  104. 6520 FORKK=1TON1-1
  105. 6530 IFA1$(KK)>A1$(KK+1)THENDD$=A1$(KK):A1$(KK)=A1$(KK+1):A1$(KK+1)=DD$:SS$="YES"
  106. 6540 NEXTKK
  107. 6550 IFSS$="YES"THEN6510
  108. 6560 RETURN
  109. 7000 REM ROBUST NUMBER INPUT
  110. 7010 XX$="":PP=0
  111. 7020 GETAA$:IFAA$=""THEN7020
  112. 7030 IFAA$>="0"ANDAA$<="9"THENPRINTAA$;:XX$=XX$+AA$:PP=PP+1:GOTO7020
  113. 7040 IFASC(AA$)<>20THEN7070:REM LOOK FOR DEL
  114. 7050 IFPP=0THEN7020:REM CAN'T ERASE NOTHING!
  115. 7060 PRINT"[157] [157]";:PP=PP-1:XX$=LEFT$(XX$,PP):GOTO7020
  116. 7070 IFASC(AA$)<>13THEN 7020:REMLOOK FOR RETURN
  117. 7080 IFPP=0THEN7020
  118. 7090 X1=VAL(XX$):RETURN
  119. 8000 REM DISPLAY CHARACTER IN A1$ FOUR TIMES USUAL SIZE
  120. 8010 BB=ASC(A1$)
  121. 8020 IFBB=13ORBB=141THEN PRINT"":RETURN
  122. 8030 IFBB=18THENQQ=1:RETURN
  123. 8040 IFBB=146THENQQ=0:RETURN
  124. 8050 IFBB<32THENPRINTMID$("[146][146][146][146][146][146][146][146][146][146][146][146][146][146][146][146] [146][146][146][146][146][146][146][146][146][146]",BB+1,1);:RETURN
  125. 8060 IFBB>=144 AND BB<160THENPRINTMID$("[144][146][146][147][146][146][146] [146][146][146][146][156][146][158][159]",BB-143,1);:RETURN
  126. 8070 AA=(BBAND31)+0.5*(BBAND128):IF(BBAND64)=0THENAA=AA+32
  127. 8080 FORJJ=0TO6STEP2
  128. 8085 POKE 56334,PEEK(56334)AND 254:POKE 1,PEEK(1) AND 251
  129. 8090 KK=PEEK(53248+8*AA+JJ):LL=PEEK(53249+8*AA+JJ)
  130. 8095 POKE 1,PEEK(1) OR 4:POKE 56334,PEEK(56334) OR 1
  131. 8100 NN=64:FORMM=0TO3
  132. 8110 PP=1+8*INT(KK/NN)+2*INT(LL/NN)
  133. 8120 KK=KK-INT(KK/NN)*NN:LL=LL-INT(LL/NN)*NN
  134. 8130 IFQQ=0THENPRINTMID$("[146] [146][172][146][187][146][162][146][188][161][191][190][146][190][146][191][146][161][188][162][187][172] ",PP,2);:GOTO8150
  135. 8140 PRINTMID$(" [172][187][162][188][146][161][146][191][146][190][190][191][161][146][188][146][162][146][187][146][172][146] ",PP,2);
  136. 8150 NN=INT(NN/4):NEXTMM
  137. 8160 PRINT"[157][157][157][157]";
  138. 8170 NEXTJJ
  139. 8180 PRINT"[145][145][145][145]";
  140. 8190 IF PEEK(211)>36THENPRINT""
  141. 8200 RETURN
  142. 9000 REM SOLVE N1 SIMULTANEOUS EQUATIONS A1.X1=B1
  143. 9010 IFN1=1THENX1(1)=B1(1)/A1(1,1):RETURN
  144. 9020 FORJJ=1TON1-1:REM FIND PIVOT
  145. 9030 DD=ABS(A1(JJ,JJ)):LL=JJ
  146. 9040 FORKK=JJTON1
  147. 9050 IFABS(A1(KK,JJ))>DDTHENDD=ABS(A1(KK,JJ)):LL=KK
  148. 9060 NEXTKK
  149. 9070 IFLL=JJTHEN9120
  150. 9080 FORKK=JJTON1
  151. 9090 DD=A1(JJ,KK):A1(JJ,KK)=A1(LL,KK):A1(LL,KK)=DD
  152. 9100 NEXTKK
  153. 9110 DD=B1(JJ):B1(JJ)=B1(LL):B1(LL)=DD
  154. 9120 FORKK=JJ+1TON1:DD=A1(KK,JJ)/A1(JJ,JJ)
  155. 9130 FORLL=JJTON1:REM ELIMINATE
  156. 9140 A1(KK,LL)=A1(KK,LL)-DD*A1(JJ,LL)
  157. 9150 NEXTLL
  158. 9160 B1(KK)=B1(KK)-DD*B1(JJ)
  159. 9170 NEXTKK
  160. 9180 NEXTJJ
  161. 9190 FORJJ=N1TO1STEP-1:REM BACK SUBSTITUTE
  162. 9200 DD=B1(JJ)
  163. 9210 IFJJ=N1THEN9250
  164. 9220 FORKK=JJ+1TON1
  165. 9230 DD=DD-X1(KK)*A1(JJ,KK)
  166. 9240 NEXTKK
  167. 9250 X1(JJ)=DD/A1(JJ,JJ)
  168. 9260 NEXTJJ
  169. 9270 RETURN
  170. 10000 DEFFNA(X)=PEEK(X)+256*PEEK(X+1)
  171. 10010 P=43:POKE832,PEEK(43):POKE833,PEEK(44)
  172. 10020 P=FNA(P):IFFNA(P+2)<10000THEN 10020
  173. 10030 POKE43,PAND255:POKE44,INT(P/256)
  174. 10040 PRINT "[147]LIBRARY SELECTION":PRINT
  175. 10050 PRINT"THIS PROGRAM CAN'T BE RESTARTED EXCEPT
  176. 10060 [153]"BY LOADING FROM DISK OR TAPE"
  177. 10070 [153]
  178. 10080 [153]"ANSWER Y OR N FOR EACH OF THE FOLLOWING"
  179. 10090 [135]X$,M1,N1
  180. 10100 [139]X$[178]"ZZ"[167]10170
  181. 10110 [153]"";X$
  182. 10120 [153]"(LINES";M1;"-";N1;")"
  183. 10130 [133]A$
  184. 10140 [139][200](A$,1)[178]"Y"[167]10090
  185. 10150 [139][200](A$,1)[178]"N"[167][141]10500:[137]10090
  186. 10160 [153]"ANSWER YES OR NO":[137]10570
  187. 10170 [153]"AT 'READY' SAVE ON A  NEW TAPE OR DISK"
  188. 10180 [153]"FILE. NOW WAIT FOR READY."
  189. 10200 [143] COMPACT UP
  190. 10210 Q[178][165]A(832):P[178][165]A(Q)
  191. 10220 PT[178][165]A(P):QT[178]Q
  192. 10230 [139][165]A(P[170]2)[178]10000[167] 10280
  193. 10240 [151]Q[170]2,[194](P[170]2):[151] Q[170]3,[194](P[170]3)
  194. 10245 P[178]P[170]4:Q[178]Q[170]4
  195. 10250 J[178][194](P):[151]Q,J:P[178]P[170]1:Q[178]Q[170]1:[139]J[179][177]0[167]10250
  196. 10260 [151]QT,Q [175] 255:[151] QT[170]1,[181](Q[173]256)
  197. 10270 P[178]PT:[137]10220
  198. 10280 [151]Q,0:[151]Q[170]1,0:Q[178]Q[170]2:[151]834,Q[175]255:[151]835,[181](Q[173]256)
  199. 10290 [151]43,[194](832):[151]44,[194](833):[151]45,[194](834):[151]46,[194](835):[128]
  200. 10310 [131]"TOLERANT INPUT",4500,4660
  201. 10320 [131]"ROBUST INPUT",7000,7090
  202. 10330 [131]"BIGLETTERS",8000,8200
  203. 10340 [131]"FORMATTED NUMBER",5000,5130
  204. 10350 [131]"STRING DISPLAY",5700,5800
  205. 10360 [131]"BINARY CONVERTER",1000,1060
  206. 10370 [131]"EXTRACT SURNAME",4100,4200
  207. 10380 [131]"LIST SEARCH",6000,6050
  208. 10390 [131]"BUBBLE SORT",6500,6560
  209. 10400 [131]"QUICKSORT",6200,6380
  210. 10410 [131]"FRACTION SIMPLIFIER",5500,5630
  211. 10420 [131]"SIMULTANEOUS EQUATIONS",9000,9270
  212. 10490 [131]ZZ,0,0
  213. 10500 PP[178][165]A(832)
  214. 10510 SS[178][165]A([165]A(PP)[170]2):[139]SS[179][177]M1[167]PP[178][165]A(PP):[137]10510
  215. 10520 QQ[178][165]A(PP)
  216. 10530 SS[178][165]A(QQ[170]2):QQ[178][165]A(QQ):[139]SS[179][177]N1[167]10530
  217. 10540 [151]PP,QQ[175]255:[151]PP[170]1,[181](QQ[173]256):[142]
  218.